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-- Swapper. Mesa Edited by Sandman on October 6, 1977 7:19 AM 

DIRECTORY 

AUoDefs: FROM "altodefs". 
AUoFileDefs: FROM "altof iledef s" , 
BooLDefs: FROM "bootdefs", 
ControlDefs: FROM "controldef s" , 
DiskDefs: FROM "diskdefs", 
FrameDefs: FROM "framedefs", 
InlineDers: FROM " in1 inedef s" , 
MiscDefs: FROM "miscdefs", 
ProcessDefs: FROM "processdef s" , 
SegmentDefs: FROM "segmentdef s" ; 

DEFIMITIONS FROM AUoDefs, AUoFileDefs, BootDefs. DiskDefs, SegmentDefs; 

Swapper: PROGRAM [ffvmp, Ifvmp: PageNumber] 
IMPORTS BootDefs, FrameDefs, SegmentDefs 

FXPORTS BootDefs, DiskDefs, FrameDefs, MiscDefs, SegmentDefs 
SHARES DiskDefs, SegmentDefs = BEGIN 

nil : POINTER = LOOPHOLE[0]; 

driveNumber: PUBLIC [0..1] ♦- 0; 

sysdisk: DISK ♦- DISK[nDi sks , nTracks . nHeads . nSectors] ; 

disk: POINTER TO DISK = Qsysdisk; 

Zero: PUBLIC PROCEDURE [ 
p:POINTER, 1 :CARDINAL] = 
BEGIN 

IF 1=0 THEN RETURN; pt ♦- 0; 
InlineDefs.COPY [ 

from:p, to:p + l, nwords:Ul]; 
RETURN 
END; 

SetDisk: PUBLIC PROCEDURE [ 
d:POINTER TO PISK] = 
BEGIN 

diskt ♦- dt ; 
RETURN 
END; 

GetDisk: PUBLIC PROCEDURE 
RETURNS [POINTER TO DISK] = 
BEGIN 

RETURN[disk] 
END; 

ResetDisk: PUBLIC PROCEDURE 
RETURNS [POINTER TO DISK] = 
BEGIN 

diskt <- DISK[nDisks . nTracks . nHeads , nSectors] ; 
RFTURN[disk] 
END; 

VirtualDA: PUBLIC PROCEDURE [da:DA] RETURNS [vDA] = 
BEGIN 

RETURN[IF da = DA[0. 0,0.0,0] THEN eofDA ELSE vDA [ 
((da.disk*disk. tracks + da. track)*d Jsk.heads + 
da.head)*disk. sectors+da. sector]]; 
END; 

RealDA: PUfil IC PROCFDURE [v:vDA] RETURNS [da:OA] = 
BEGIN 

i : CARDINAL ^ v; 
da ^ DA[0,0.0,0,0]; 
IF V // eofDA THEN 

BEGIN 

[ i .da. sector] ^ In! i neOef s . ni\/MOn[ i , d i sk . sec tors ] ; 

[i. da. head] - Tnl i neOefs . DrVMOD[ i . d i sk . heads] ; 

[i. da. track] *- In! i neOefs .DIVMOD[ i , d i sk . tracks] ; 

[i. da. disk] ^ Jul i neOefs . niVMOD[ i . d isk . d i sks ] : 

rr i // THFN da ♦- Inval idDA; 

fNO; 
RETURN 
END; 
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-- Disk transfer "process" 



DCseal: BYTE = HOB; 



DCs: ARRAY 
DC[DCseal 
DC[DCseal 
DC[DCseal 
DC[DCsea1 
DC[DCseal 
DC[DCseal 
DC[DCsea1 
DC[DCsea1 



vOC OF DC 

,Di skRead , 

.DiskCheck 

.DiskCheck 

.DiskWrite 

.DiskCheck 

, DiskCheck 

.DiskCheck 

.DiskCheck 



= C 
DiskRead, DiskRead, 0,0] 
.DiskRead, DiskRead, 0,0] 
.DiskCheck, DiskRead, 0,0] 
.DiskWrite. DiskWrite, 0,0] 
, DiskWrite, DiskWrite, 0,0] 
.DiskCheck. DiskWrite, 0,0] 
.DiskCheck.DiskCheck. 1,0] 
.DiskCheck. DiskCheck, 0,0]] 



-- ReadHLD 
-- ReadLO 
-- ReadD 
-- WriteHLO 
-- WriteLD 
-- WriteO 
-- SeekOnly 
-- DoNothing 



nextDiskCommand: POINTER TO CBptr = LO0PHOLE[521B] ; 
diskStatus: POINTER TO DS = LOOPHOLE[522B] ; 
lastDiskAddress: POINTER TO DA = L00PH0LE[523B] ; 
sectorlnterrupts: POINTER TO CARDINAL = L00PH0LE[524B] ; 

-- DoDiskCommand assumes that the version number in a FID (and 

-- in an FP) will never be used (is always one). It further 

-- assumes that if fp is nil (zero), a FreePageFID was meant; 

-- this allows the rest of the world to use short (3 word) FPs. 

FreePageFID: FID = FID[-1 ,SN[t . 1 . 1 . 17777B. -1]]; 

NonZeroWaitCell : WORD ♦- 1; 

waitCell: POINTER TO WORD ♦- QNonZeroWai tCell ; 

ResetWaitCell: PUBLIC PROCEDURE = 
BEGIN 

waitCell <- QNonZeroWai tCell ; 
END; 

SetWaitCell: PUBLIC PROCEDURE [p: POINTER TO WORD] RETURNS [preval : POINTER TO WORD] 
BEGIN 

ProcessDefs.DisableInterrupts[]; 
preval ^ wai tCel 1 ; 
wai tCel 1 ♦• p ; 

Process Defs. En ablelnterrupts[]; 
RETURN; 
END; 

PUBLIC PROCEDURE [arg:POINTER TO DDC] = 
rg; 

rev: CBptr; 
TO DL; 

= cb.zone; 
ress ♦- @cb. header; 
labelAddress) = nil THEN 
dress ♦-la*- @cb. 1 abel ; 
ss ♦- ca; 

Wakeups = THEN cb . normalWakeups ♦- zone . normalWakeups ; 
akeups = THEN cb .errorWakeups ♦- zone. errorWakeups ; 
THEN la.filelD ♦- FreePageFID 

NIL THEN la.filelD «- riD[l . fp . seri al ] ; 
.page <- page; 

inOA THEN cb . header . d i skAddress *• RealDA[da]; 
WZH cb . header . d iskAddress . res tore ♦- 1; 

DCs[ac t ion] ; 
X change ♦- driveNumber; 
B[zone] ; 

ommand on the disk controller's queue 
Disablelnterrupts[]; 

lit /y DO NULL FNDIOOP: -- Wait for Trident to finish 
exlDiskCommandr) // nil THFN 

next; next *- ptr.nextCB; 
= nil THEN fXIT; 

♦• cb ; 

of a possible raco with disk controller. The disk 
gone idle (perhaps due to an error) even as we were 
command to the chain. fo make sure there was no 

check the status of the previous cb in this /one. 



DoDiskCommand: 


BEGIN OPEN a 


ptr, next, p 


la 


: POINTER 


zone: CBZptr 


cb 


.headerAdd 


IF 


(la ♦- cb. 




cb. labelAd 


cb 


. dataAddre 


IF 


cb . normal 


IF 


cb . errorW 


IF 


fp = nil 


ELSC IF fp ^ 


la 


.page ♦- cb 


IF 


da ff fill 


IF 


restore T 


cb 


.command ♦- 


cb 


. command .e 


prev <r PrevC 


__ 


Put the c 


ProcessOef s . 


UNFII waiLCe 


IF 


(next *- n 




^FGIN 


[ 


10 ptr - 




IF next 




rNDIOOP; 




olr .nextCB 




"ND; 


-- 


Take care 


__ 


may have 


-- 


adding a 


-- 


error , we 
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IF nextDiskCommand'^ = nil THEN 

SELECT MaskDS[prev. status, DSmaskStatus] FROM 

DSf reeStatus , DSgoodStatus => nextDiskCommandt ♦- cb; 

ENDCASE; 
ProcessDefs .Enab1elnterrupts[]; 
EnqueueCB[2one, cb] ; 
RETURN 
END; 
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-- Disk command block queue 

InitializeCBstorage: PUBLIC PROCEDURE [ 

zone:CBZptr. nCBs : CARDINAL, page: PageNumber , init:CBinit] 

BEGIN 

cb: CBptr; 

i: CARDINAL; 

nq: CARDINAL = nCBs+1; 

length: CARDINAL = SIZE[CBZ]+nCBs-*(SIZE[CB]+SIZE[CBptr] ) ; 

queue: DESCRIPTOR FOR ARRAY OF CBptr ♦■ 

DESCRIPTOR[0zone.queue\/ec,nq]; 
cbVector: DESCRIPTOR FOR ARRAY OF CB ♦■ 

DESCRIPTOR[@zone.queueVec+SIZE[CBptr]*nq,nCBs]; 
IF init = clear THEN Zero[zone, 1 ength] ; 
zone . currentPage ♦- page; zone.cbQueue ♦■ queue; 
zone.qTail ♦- 0; zone.qHead ♦- 1; 
queue[0] ^ NIL; -- end of queue; 
FOR i IN [1. .nCBs] DO 

queue[i] ♦• cb ^ @cbVector[i-l] ; 

cb.zone ♦■ zone; cb. status «- DSf reeStatus; 

ENDLOOP; 
RETURN 
END; 

NumCBs: PROCEDURE [zone : CBZptr] RETURNS [CARDINAL] = 
BEGIN 

RETURN[LENGTH[ zone.cbQueue]-!] 
END; 

ClearCB: PROCEDURE [cb:C8ptr] = 
BEGIN 

zone: CBZptr = cb.zone; 
Zero[cb,SIZE[CB]]; 
cb.zone <- zone; 
RETURN 
END; 

EnqueueCB: PROCEDURE [zone: CBZptr , cb:CBptr] = 
BEGIN i: CARDINAL ^ zone.qTail; 
IF zone.cbQueue[i] # NIL THEN ERROR; 
zone. cbQueue[i ] ^ cb; 

IF (i *- i + 1) = LENGTH[zone.cbQueue] THEN i ♦- 0; 
zone.qTail ♦• i; 
RETURN 
END; 

DequeueCB: PROCEDURE [zone :CBZptr] RETURNS [cb:CBptr] = 
BEGIN i: CARDINAL ♦- zone.qHead; 
IF (cb *- zone.cbQueue[i]) = NIL THEN ERROR; 
zone . cbQueue[ i ] ♦- NIL; 

IF (i ^ i + 1) = LENGTH[zone.cbQueue] THEN i «- 0; 
zone . qHead ♦- i ; 
RETURN 
END; 

PrevCB: PROCEDURE [zone : CBZptr] RETURNS [cb:CBpLr] = 
BEGIN i: CARDINAL *■ zone.qTail; 

i *- (IF 1=0 THEN LENGTH[zone.cbQueue] ELSE i) - 1; 
IF (cb ♦- zone.cbQueue[i]) = NIL THEN ERROR; 
RETURN 
END; 

CleanupCBqueue: PUBl IC PROCEDURE [zone :CBZp tr] = 
BEGIN 
cb: CBptr; 
UNTIl /one. cbOueue[/one. qHead] = NIL DO 

cb ♦- GetCB[zone , don tCl ear] ; 

ENDLOOP; 
RETURN 
END; 
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— Removing CBs from the queue. If for some reason the disk has 

— gone idle without executing the command, we fake an error 
-- in it so that the entire zone of CBs will get retryed. 

RetryableDiskError: PUBLIC SIGNAL [cb:CBptr] = CODE; 
UnrecoverableDiskError: PUBLIC SIGWAL [cb:CBptr] = CODE; 

MaskDS: MACHINE CODE [DS, OS] RETURNS [DS] = LOOPHOLE[Inl i neDef s . BITAND] ; 

GetCB: PUBLIC PROCEDURE [zone : CBZptr . init:CBinit] RETURNS [cb:CBptr] = 
BEGIN s:DS: darvDA; ddc:DDC; ec:CARDINAL; 
cb *- DequeueCB[zone] ; 
UNTIL cb. status. done ^^ DO 

-- not zero means done or fake or free 
IF nextDiskCommandt = nil 
AND cb. status. done = THEN 
cb. status ♦- DSfakeStatus ; 
ENOLOOP; 
cb .command . seal ♦• 0; -- remove command seal 
s *- MaskDS[cb. status, DSmaskStatus] ; 
SELECT s FROM 
DSgoodStatus => 
BEGIN 

IF cb . header . diskAddress . restore = THEN 
BEGIN 

zone . errorCount ♦• 0; 

zone . curren tBytes *- cb . label Address .by tes; 
IF zone. cleanup # LOOPHOLE[0] THEN zone . c1eanup[cb] ; 
END; 
IF init = clear THEN ClearCB[cb3: 
END; 
DSfreeStatus => 

ClearCB[cb]; -- really means DSneverBeenUsed 
ENDCASE => 

BEGIN -- some error occurred 

-- busy wait until disk controller is idle 

UNTIL nextDiskCommandt = nil DO NULL ENDLOOP; 

ec ♦- zone . errorCount ♦- zone . errorCount+1 ; 

IF ec >= RetryCount THEN ERROR Unrecoverabl eD iskError[cb] ; 

da *• zone.errorDA ^ Vi rtualDA[cb . header . diskAddress] ; 

IF cb . status . f inalStatus = CheckError THEN zone . checkError ♦- TRUE; 

Initial izeCBs torage [ 

zone , NumCBs[zone] , cb. page, don tClear]; 
IF ec > RetryCount/2 THEN 

BEGIN -- start a restore before signalling the error 
lastDiskAddresst ♦- InvalidDA; 

ddc ^ DDC[GetCB[zone, clear], nil , da. 0, NIL. TRUE, SeekOnly]; 
DoDiskCommand[@ddc] ; 
END; 
ERROR RetryableDiskError[cb]; 
END; 
RETURN 
END; 

-~ Don't all Cleanup procedures need to be locked? 
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-- Segment swapper 

-- Note that each CB is used twice: first to hold the disk label' 

-- for page i-1, and then to hold the DCB for page i. It isn't 

-- reused until the DCB for page i-1 is correctly done, which 

-- is guaranteed to be after the disk label for page i-1 is no 

-- longer needed, since things are done strictly sequentially by 

— page number. 

-- Currently, DiskRequest . lastAction is not used by SwapPages. 

DiskCheckError: PUBLIC SIGNAL [page : PageNumber] = CODE; 

SwapPages: PUBLIC PROCEDURE [arg:POINTER TO swap DiskRequest] 
RETURNS [PageNumber, CARDINAL] = 
BEGIN OPEN arg; 
i: PageNumber; 
cb, nexlcb: CBptr; 

cb/one: ARRAY [0..1CBZ) OF UNSPECIFIED; 
zone: CBZptr = @cbzone[0]; 
ddc: DDC ♦- DDC[ . ca , dat ,. fp , FALSE , action] ; 
Tni tial izeCBstorage[/one , nCB,firstP age, clear]; 
IF desc if NIL THEN 

BEGIN zone, info ♦• desc; 
zone. cleanup ♦- GetDiskPageDesc; 
END; 
BEGIN 

ENABLE RetryableDiskError --[cb]-- => 
BEGIN 

ddc. da ^ zone . errorDA; 
ddc.ca *- cb. dataAddress ; 
RETRY END; 
cb <- GetCB[zone .clear]; 

FOR i ♦- zone.currentPage, i + 1 UNTIL i = lastPage+l DO 
IF ddc. da = eofDA THEN EXIT; 
IF signalCheckError AND zone. errorCount = RetryCount/2 

THEN SIGNAL D lskCheckError[ i ] ; 
nextcb ♦- GetCB[zone , clear] ; 

cb. labelAddress *- LOOPHOLE[0nextcb .header . diskAddress] ; 
ddc.cb <- cb; ddc. page ^ i; 

IF i ff zone.currentPage THEN ddc. da ♦- fillinDA; 
DoDiskCommand[0ddc] ; 

IF -fixedCA THEN ddc.ca ♦- ddc . ca+PageSize; 
cb <- nextcb; 
ENDLOOP; 
CleanupCBqueue[zone] ; 
END; -- of enable block 
RETURN[i-l .zone. cur rent Bytes] 
END; 

GetDiskPageDesc: PROCEDURE [cb:CBptr] = 
BEGIN 

la: POINTER TO DL = cb . 1 abel Address : 
desc: POINTER TO DiskPageDesc ^ cb . zone . info; 
desct ♦- DiskPageDesc [ 

Vir tualDA[la.prev] , 

VirLualDA[cb. header. diskAddress] , 

\/irtualDA[la.next], 

la. page, la, bytes]; 
RETURN 
END; 
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— Routines for peering into machine addresses 

PAGEDISP: TYPE = MACHINE DEPENDENT RECORD [ 
page: [0. .MaxVMPage] , 
disp: [0. .PageSize)]: 

PageFromAddress: PUBLIC PROCEDURE [a:POINTER] RETURNS [PageNumber] = 
BEGIN 

RETURN[LOOPHOLE[a. PAGEDISP]. page] 
END; 

AddressFromPage: PUBLIC PROCEDURE [p: PageNumber] RETURNS [POINTER] = 
BEGIN 

RETURN[LOOPHOLE[PAGEDISP[p,0]]] 
END; 

PagePointer: PUBLIC PROCEDURE [a:POINTER] RETURNS [POINTER] = 
BEGIN 

LOOPIIOLE[a. PAGEDISP]. disp ^ 0; 
RETURN[a] 
END; 

-- Data Segments 

VMNotFree: PUBLIC SIGNAL [base : PageNumber , pages : PageCount] = CODE; 

NewDataSegment: PUBLIC PROCEDURE [base : PageNumber . pages: PageCount] 
RETURNS [seg:DataSegmentHandle] = BEGIN 
IF pages -IN (0 . .MaxVMPage+1] 

THEN ERROR InvalidSegmen tSi ze[pages] ; 
seg ♦• Al locateDataSegment[OataSegmentTab1e] ; 

BEGIN ENABLE UNWIND => L iberateDataSegmen t[DataSegmentTab1 e . seg] ; 
IF base = DefauUBase THEN 

base ♦- AT 1ocVM[pages , top , TrySwapping] 
ELSE BEGIN 

DO -- until pages free 

ProcessDefs.DisableInterrupts[]; 
IF PagesFree[base , pages] THEN EXIT; 
Process Defs. En ablelnterrupts[]; 
SIGNAL VMNotFree[base, pages]; 
ENDLOOP; 
UpdateVM[base,pages .busy] ; 
ProcessDefs.Enab1eInterrupts[]; 
END; 
END; 
seg.VMpage *■ base; 
seg. pages ^ pages ; 
RETURN 
END; 

BootDataSegment: PUBLIC PROCEDURE [base : PageNumber . pages : PageCount] 
RETURNS [seg:DataSegmentHand1e] = BEGIN 
i: PageNumber; 
FOR i IN [base. .base+pages) 00 

IF Pagerree[i] THEN ERROR; 

ENDLOOP; 
seg ^ AnocateDataSegment[DataSegmentTab1e] ; 
seg.VMpage *- base; 
seg . pages <- pages ; 
RETURN 
END; 

DeleleDataSegment: PUBLIC PROCEDURE [seg : DataSegmen tHandl e] = 
BEGIN 

base: PageNumber; pages: PageCount; 
Val idateDataSegmen t[na taSegmen tlabl e, seg] ; 
base *- seg.VMpage: pages *- seg. pages; 
I iberaleDaLaSegmen t[ Da taSegmen LTable.seg]; 
UpdaleVM[base .pages. free]; 
RLTURN 
FND; 

DalaSegmenLAddress: PUBLIC PROCFDURE [seg : DataSegmen tHandle] RETURNS [POINTfR] 
BEGIN 
RrTURN[LOOPtlOLE[PAGrDTSP[seg.VMpage.O]]] 
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END; 
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-- Swapping Segments 

SwapError: PUBLIC SIGNAL [seg : Fi leSegmentHandle] « CODE; 

Swapin: PUBLIC PROCEDURE [seg : FileSegmentHandle] = 
BEGIN OPEN seg; 

IF lock = MaxLocks THEN SIGNAL SwapError[seg]; 
ProcessDefs,DisableInterrupts[]; 
IF -swappedin THEN 
BEGIN 

— make it busy here. 
ProcessDef s.EnableInterrupts[]; 

IF f ile.swapcount = MaxRefs THEN SIGNAL SwapError[seg] : 

IF -file. open THEN OpenFi le[f i le] ; 

VMpage ♦• Anoc\/M[pages , bottom, TrySwapping] ; 

BEGIN ENABLE UNWIND => UpdateVM[VMpage , pages . free] ; 

IF (hint. page it base OR hint. da = eofDA) 

AND PositionSeg[seg,TRUE] AND pages = 1 
THEN NULL ELSE MapVM[seg , ReadD] ; 

END; 
f i le. swapcount *- f ile. swapcount+1 ; 
ProcessDefs.DisableInterrupts[]; 

— make it unbusy here, 
swappedin ^ TRUE; 

END; 
lock <- lock+1; 

ProcessDef s. Enablelnterrupts[]; 
RETURN 
END; 

Unlock: PUBLIC PROCEDURE [seg : Fi leSegmentHandle] = 
BEGIN OPEN seg: 
IF lock = THEN 

ERROR SwapError[seg] ; 
Process Defs.Disablelnterr up ts[]; 
lock ♦■ lock-1; 

ProcessDef s. E'-ableInterrupts[]; 
RETURN 
END; 

SwapUp: PUBLIC PROCEDURE [seg : Fi 1 eSegmentHandle] = 
BEGIN OPEN seg; 
IF swappedin AND write THEN 

BEGIN 

IF -file. open THEN OpenFi le[fi le] ; 

IF hint. page U base 

OR hint. da = eofDA THEN 

[] ♦- PositionSeg[seg, FALSE]; 

MapVM[seg,Wrl teD]; 

END; 
RETURN 
END; 

SwapOut: PUBLIC PROCEDURE [seg : F i leSegmen LHandle] = 
BEGIN'OPEN seg; 
temp: PageNumber; 
IF -swappedin THFN RETURN; 
IF lock if THEN ERROR SwapError[seg] ; 
SwapUp[seg] ; 

ProcessDefs.DisableInterrupts[]; 
swappedin ♦- FALSE; 
Lemp ♦- VMpage; VMpage ♦- 0; 
r i le . swapcount <- f i le . swapcoun t- 1 ; 
Process Oefs.fnabl el nterrupts[]; 
-- If swapcount = THEN CloseFile[]: ??? 
UpdateVM[temp .pages , free] ; 
RETURN 
END; 

Segmentfaul t: PUBI IC SIGNAl [ seg : F i leSegmen thand! e , pages : PageCount] = CODE; 

MapVM: PUBI IC PROCrDURr [seg : f i 1 eSegmen tMand 1 e . dc:vDC] = 
BEGIN OPEN seg: 

page: PageNumber; byte: CARDINAI ; temp : PageCount ; 
arg: swap DiskRequest ♦- DIskRequest [ 
Ad d r ess FromP age [VMpage] . 0h int . da. 
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base, base+pages-1 , Qfile.fp, 

FALSE, dc, dc, FALSE, swapCNIL]]; 
IF hint. page j^ base THEN ERROR SwapError[seg] ; 
[page, byte] ♦• SwapPages[0arg] ; 
temp ♦- page-base+(IF byte = THEM ELSE 1); 
IF temp = THEN ERROR SegmentFauU[seg, 0] ; 
IF temp ff pages THEN 

BEGIN SIGNAL Segmen tFauUCseg , temp] ; 

Up d a teVM[\/Mpage+ temp, pages -temp, free] ; 

pages ♦- temp; 

END; 
RETURN 
END: 
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-- Code Swapping and Swap Strategies 

TrySwapInProgress: BOOLEAN ♦• FALSE; 

TrySwapping: PROCEDURE RETURNS [did: BOOLEAN] = 
BEGIN sp, next: POINTER TO SwapStrategy ,• 
P^ocessDef s .Disablelnterrupts[]; 
IF TrySwapInProgress THEN 

BEGIN 

ProcessDef s. Enab1elnterrupts[]; 

RETURN[TryCodeSwapping[]]; 

END; 
TrySwapInProgress ^ TRUE: 
ProcessOefs.Enab1eInterrupts[]; 
did ♦• TRUE: 
FOR sp *- StrategyList, next UNTIL sp = NIL DO 

next ♦• sp . 1 ink ; 

IF sp.proc[] THEN EXIT; 

REPEAT FINISHED => did ♦- FALSE; 

ENDLOOP; 
TrySwapInProgress ^ FALSE; 
RETURN 
END; 

CantSwap: PUBLIC SwappingProcedure = 
BEGIN 

RETURN[FALSE] 
END; 

gftrover: ControlDef s .GFTIndex ♦• 1; 

TryCodeSwapping: PUBLIC SwappingProcedure = 
BEGIN OPEN ControlDefs; 
g: POINTER TO GFTItem; 
passtwo: BOOLEAN ♦- FALSE; 
start: GFTIndex <- gftrover; 

sd: POINTER TO ARRAY [0..0) OF CARDINAL = REGISTER[SDreg] ; 
gft: DESCRIPTOR FOR ARRAY OF GFTItem = 

DESCRIPTOR[REGISTER[GFTreg],sd[sGFTLength]]; 
DO -- until we've looked at them all twice 
ProcessDefs.DisableInterrupts[]; 

IF (gftrover ♦- gftrover + l) = sd[sGFTLength] THEN gftrover ♦- 1; 
IF gftrover = start THEN 
IF passtwo THEN EXIT 
ELSE passtwo ♦- TRUE; 
g ^ Ogf t[gftrover] ; 

IF g. frame ff NULLFrame AND g.epbase = 
AND g . frame. codesegment . swapped in 
AND g . frame. codesegment . lock = THEN 

IF g . frame .codebasei' # THEN g. frame . codebaset ^ 
ELSE 
BEGIN 

Process Defs. En ablelnterr up ts[]; 
SwapOutCode[g . frame] ; 
RCTURN[TRUE] 
END; 
ProcessDefs. E n ablelnterr up ts[]; 
FNDLOOP; 
ProcessDefs. Cnablelnterrupts[]; 
RETURN[FALSE] 
END; 

SwapOutCode: PUBI IC PROCEDURE [f : Con trolDef s . Gl obal FrameHandle] = 
BFGIN OPTN ControlDefs: cseg: F i 1 eSegmen tHandl e ; 
g: Global FrameHandle ♦- f . accessl J nk ; 
dup found: BOOl FAN; 
r indOup: PROCFDURF [ tes tf : Gl obal Frameflandl e] 

RFTURNS [ROOl FAN] = BFGIN 

HFTURN[cseg = tos tf . codesegmen t AND testf ff g] 

FND; 
MarkFrame: PROCroURF [ f : Gl obal Frameflandl e] 

RFIURNS [BOOl FAN] = BFGIN 

TF cseg = f . codesegment THEN 
f.codebase *- 100PH0LF[1]; 

RrTURN[FALSF] 

FND; 
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IF g.accesslink # g THEN ERROR SwapError[NIL]; 
cseg ♦• g.codesegment; 
ProcessDef s.DisableInterrupts[]; 
IF cseg .swappedin THEN 

BEGIN 

Swapln[cseg]; -- lock it so it won't go away 

ProcessDefs.EnableInterrupts[]; 

dupfound ♦- FrameOefs .EnuiTierateG1obalFrames[FindDup] # NULLFrame; 

ProcessDefs.DisableInterrupts[]; 

IF dupfound THEN [] «- FrameDefs . EnumerateGlobal Frames[MarkFrame] 

ELSE g.codebase ^ L00PH0LE[1]; 

Unlock[cseg]; SwapOut[cseg] ; 

END; 
ProcessDef s .Enablelnterrupts[]; 
RETURN 
END; 

LastResort: SwapStrategy ♦• SwapStrategy[NIL .TryCodeSwapp ing] ; 
StrategyList: POINTER TO SwapStrategy ♦- QLastResort; 

AddSwapStrategy: PUBLIC PROCEDURE [strategy ; POINTER TO SwapStrategy] = 
BEGIN 

sp: POINTER TO SwapStrategy; 
ProcessDers.Disab1eInterrupts[]; 
FOR sp *- StrategyList, sp.link 
UNTIL sp = NIL DO 

IF sp = strategy THEN RETURN; 

ENOLOOP; 
strategy. 1 ink ♦• StrategyList; 
StrategyList «- strategy; 
ProcessDef s. Enab1elnterrupts[3; 
RETURN 
END; 

RemoveSwapStrategy: PUBLIC PROCEDURE [strategy : POINTER TO SwapStrategy] 
BEGIN 

sp: POINTER TC SwapStrategy; 
prev: POINTER TO SwapStrategy ♦■ NIL; 
ProcessDefs.Disab1eInterrupts[]; 
FOR sp ♦- StrategyList, sp.link UNTIL sp = NIL DO 
IF sp = strategy THEN 
BEGIN 
IF prev = NIL 

THEN StrategyList ♦- sp.link 
ELSE prev. link ♦- sp.link; 
EXIT END; 
prev ♦" sp; 
ENDLOOP; 
ProcessDefs.EnableInterrupts[]; 
strategy. 1 ink ^ NIL; 
RETURN 
END; 
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-- Memory Allocator 

PageState: TYPE = {free, busy}; 

PageMap: ARRAY [0 . . (MaxVMPage+l)/word1ength) OF WORD; 

GetPageMap: PUBLIC PROCEDURE RETURNS [POINTER] « 
BEGIN RETURN[@PageMap[0]] END; 

MapAddress: TYPE = MACHINE DEPENDENT RECORD [ 
fill: [0,.377B]. 
word: [0,.17B]. 
bit: C0..17B3]; 

-- Warning: the bits in PageMap are numbered backwards (bit zero on the right)! 

PageFree: PUBLIC PROCEHURE [page:PageNumber] RETURNS [BOOLEAN] = 
BEGIN OPEN InlineDefs; 
ma: MapAddress = LOOPHOLE[page]; 
RETURN[ma.fm*0 AND 

BITAND[PageMap[ma.word].BITSHIFT[l,ma.bit]]=0] 
END; 

PagesFree: PUBLIC PROCEDURE [base: PageNumber . pages:PageCount] RETURNS [BOOLEAN] = 
BEGIN 
FOR base IN [base . .base+pages) DO 

IF -PageFree[base] THEN RETURN[FALSE] ; 
ENOLOOP; ' 

RETURN[TRUE] 
END; 

SetPageState: PROCEDURE [page: PageNumber . state: PageState] = 
BEGIN OPEN InlineDefs; 

ptr: POINTER TO WORD = 0PageMap[LOOPHOLE[page , MapAddress] .word] ; 
IF LOOPHOLE[page. MapAddress] . fi 11 n THEN ERROR; 

THEN BITAND[ptrt.BITNOT[BITSHIFT[l.LOOPHOLE[page MapAddress ]. b it]] ] 

ELSE BIT0R[ptrt.BITSHIFf[l.L00PHOLE[page, MapAddress] . b i t]] ; 
RETURN 
END; 

AllocType: TYPE = {bottom, top} ; 

InsufficientVM: PUBLIC SIGNAL [needed : PageCount] = CODE; 

AllocVM: PROCEDURE [ 

pages : PageCount , type: AllocType, 
swap: PROCEDURE RETURNS [BOOLEAN]] 
RETURNS [PageNumber] = 
BEGIN n: CARDINAL; base: PageNumber; 
direction: INTEGER = IF type = bottom THEN 1 ELSE -1; 
DO -- repeat if insufficient VM 
Process Defs.Disablelnterr up ts[]; 
IF type = bottom THEN 
BEGIN 

-- eliminate prefix of allocated pages 
FOR ffvmp INCREASING IN [ f f vmp . . 1 f vmp] DO 
IF PageFree[ffvmp] THEN EXIT; 
ENDLOOP; 
base *- ffvmp; 
END 
ELSE 
BEGIN 

-- eliminate suffix of allocated pages 
FOR Ifvmp DfCRCASING IN [ ffvmp .. 1 f vmp] 00 
IF PageFreeClfvmp] THEN EXIT; 
CNDIOOP; 
base ♦- 1 fvmp ; 
END; 
n ^ 0; -- count of contiguous free pages 
UNTIL (TF direction>0 THEN base>lfvmp FISC base<ffvmp) DO 
IF ~Pagerree[base] THEN n ^ 
fLSF IF (n - n+1) = pages THEN 
BEGIN 

IF dlrection>0 THEN base ♦- base-n + 1; 
FOR n IN [base. . base+pages) DO 
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Se t Pages t ate [n, busy]; 
ENDLOOP; 
ProcessDefs.Enab1eInterrupts[]; 
RETURN[base] 
END; 
base <- base+direction 
ENDLOOP; 
ProcessDefs.Enab1eInterrupts[]; 
IF -swap[] THEN SIGNAL Insuff icientVM[pages]; 
ENDLOOP 
END; 

UpdateVM: PROCEDURE [baserPageNumber, pages : PageCount, state:PageState] 
BEGIN 
IF state = free THEN 

BEGIN 

ProcessDef s. Disable Inter rupts[] ; 

ffvmp <r- MIN[ffvmp,base]; 

Ifvmp <- MAX[1fvmp,base+pages-l] ; 

ProcessDefs.EnableInterrupts[]; 

END; 
FOR base IN [base. .base+pages) DO 

SetPageState [base, state]; 

ENDLOOP; 
RETURN 
END; 
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-- Primative Object Allocation 

ObjectSeal: BYTE = 321B; 

InvalidObject: PUBLIC SIGNAL [table iTableHandle , object:POINTER] = CODE; 

AllocateObject: PUBLIC PROCEDURE [table:TableHandle] 
RETURNS [ObjectHandle] = BEGIN 
frob: FrobHandle; 
subtable: SubTableHandle; 
ProcessDefs.DisableInterrupts[]; 
FOR subtable ♦• table. link, subtable. 1 ink 
UNTIL subtable = NIL DO 

IF subtable. free n NIL THEN EXIT; 

REPEAT FINISHED => 

subtable ♦- Al locateSubTable[table 

I UNWIND => ProcessDef s.EnableInterrupts[]]; 

FNDLOOP; 
frob ♦• subtable. free; 
frob. inuse <- TRUE; 
subtable. free ♦• frob. link; 
subtable. alloc ♦• subtable. al loc+1 ; 
ProcessDefs.EnableInterrupts[]; 
RETURN[ LOOPHOLE [Frob]] 
END; 

LiberateObject: PUBLIC PROCEDURE [tab! e : TableHandle. object :ObjectHandle] = 
BEGIN 

subtable: SubTableHandle = PagePointer[object]; 
frob: FrobHandle = LOOPHOLE[ob ject] ; 
ProcessDef s .Disablelnterrupts[]; 
frobt <n Object[FALSE, FALSE. Free[0,]]; 
frob. link ^ sub table. free; 
sub table. free ^ frob; 
subtable. al loc ♦- subtable. al loc-1 ; 
IF subtable. alloc = THEN 

Liber at eSub"''able[t able, subtable]; 
ProcessDef s. En ablelnterrupt s[] ; 
RETURN 
END; 

AllocateSubTable: PROCEDURE [tab! e : TableHandl e] 
RETURNS [subtable:SubTableHandle] = BEGIN 
frob, prev: FrobHandle; 

n: CARDINAL = ( PageS ize-SIZE[SubTable] ) /tab le . size ; 
subtable ♦- AddressFromPage[Al locVM[l , top.TryCodeSwapp ing]] ; 
subtablet *- SubTable[ , .ObjectSeal , ,] ; 
frob ♦- subtable . free ♦- 

LOOPf^OLE[subtable+SIZE[SubTable]]; 
THROUGH [0. .n) DO 

prev ♦- frob; frob <- f rob + table. s i ze; 

prevt *- Object[FALSE,FALSE.Free[0.]]; 

prev . 1 ink ♦- frob; 

CNDLOOP; 
prev . 1 ink ♦■ NIL ; 
subtable . 1 ink ♦- table. link; 
table. link ♦- subtable; 
subtable. seg <- BootDataSegment [ 

Pag eFromAd dress [sub table] , 1] ; 
RETURN 
FND; 

I iberateSubTable: PROCEDURE [ tabl e : Tabl eHandl e . subtabl e:SubTableHandle] = 
BfGIN 

current: SubTableHandle: 
prev: SubTableHandle *- NIL; 
FOR current ♦- table. link, current. link 
UNTTl current = NIL DO 

IF current = subtable TflEN 
BFGIN 
IF prev = NIL 

THTN table, link ♦- current, link 
FISF prev. link ♦- current.lini<; 
-- oops: this had better not recur! 
DeleteDataSegmen t[curren t . seg] ; 
RFTURN 
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END; 

prev <- current; 

ENDLOOP; 
ERROR Inva1idObject[ table, sub table]; 
END; 

ValidateObject: PUBLIC PROCEDURE [table:Tablellancne, object :ObjectHandle] 
BEGIN 

i. j: CARDINAL: 

subtable: SubTableHandle = PagePointer[object]; 
[i,j] ^ InlineOefs.DIVMOO [ 

Ob j ect- LOOPHOLE [subtable+SIZE[SubTable], Ob jectHandle], table. size]; 
IF i -IN [0. .(PageSize-SIZE[SubTable])/table.size) 
OR j # OR -object, inuse OR sub table, seal f^ ObjectSeal 

THEN ERROR Inval idObject[tabl e , object] ; 
RETURN 
END; 

EnumerateObjects: PUBLIC PROCEDURE [tabletTableHandle , 
proc: PROCEDURE [Ob jectHandle] RETURNS [BOOLEAN]] 
RETURNS [object:ObjectHandle] = BEGIN 
subtable: SubTableHandle; 

n: CARDINAL = ( PageSize-SIZE[SubTable] ) /tabl e . size ; 
FOR subtable ♦- table. link, subtable . 1 ink 
UNTIL subtable = NIL DO 

IF subtable. alloc # THEN 
BEGIN 

object ♦■ LOOPHOLE[subtable+SIZE[SubTable]]; 
THROUGH [0. .n) DO 

IF object. inuse AND proc[object] THEN RETURN; 
object ♦- object+table. size; 
ENDLOOP; 
END; 
ENDLOOP: 
RETURN[NIL] 
END; 
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-- Managing Data Segment Objects 

DataSegmentObjects: Table «- Table[SIZE[DataSegmentObject] .NIL] : 
DataSegmentTable: PUBLIC TableHandle ♦- QOataSegmentObjects; 

GetDataSegmentTable: PUBLIC PROCEDURE RETURNS [TableHandle] = 
BEGIN RETURN[DataSegmentTable] END; 

AllocateDataSegment: PROCEDURE [TableHandle] RETURNS [DataSegmentHandle]; 
ValidateDataSegment: PROCEDURE [TableHandle, DataSegmentHandle]; 
LiberateDataS^gment: PROCEDURE [TableHandle, DataSegmentHandle]; 

EnumerateDataSegments: PUBLIC PROCEDURE [ 

prociPROCEDURE [DataSegmentHandle] RETURNS [BOOLEAN]] 
RETURNS [DataSegmentHandle] = 
BEGIN RETURN[LOOPHOLE[ 

EnumerateObjects[DataSegmentTable, LOOPHOLE [proc]]]] 
END; 

VMtoDataSegment: PUBLIC PROCEDURE [aiPOINTER] RETURNS [DataSegmentHandle] 
BEGIN 

pg: PageNumber ♦- PageFromAddress[a] ; 
MatchPage: PROCEDURE [seg :DataSegmentHandle] RETURNS [BOOLEAN] = 

BEGIN 

RETURN[pg IN [seg .VMpage .. seg . VMpage+seg . pages) ] 

END; 
RETURN[ EnumerateDataSegments [Match Page]] 
END; 

— Main body 

i: [0. .MaxVMPage]; 

FOR i IN [0. .MaxVMPage] DO 
SetPageState[ 1 , 

IF i IN [ffvmp. .Ifvmp] THEN free ELSE busy]; 
ENDLOOP; 

AllocateDataSegment ♦- LOOPHOLE[AnocateObject] 
ValidateDataSegment ♦■ LOOPHOLE[Val i dateObject] 
LiberateDataSegment ^ LOOPHOLE[L iberateObject] 

END. 



